home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Nibble Magazine
/
nib04.dsk
/
APPLE PAINTBOX (MODIFIED).bas
< prev
next >
Wrap
BASIC Source File
|
2023-02-26
|
7KB
|
165 lines
4 PRINT ""
10 GOTO 2000
15 SW$ = "OFF":ML = PEEK(115):MH = PEEK(116): HIMEM: 8192
17 POKE 16386,1: POKE 16387,0: POKE 16388,4: POKE 16389,0: POKE 16390,32: POKE 16391,0: POKE 232,2: POKE 233,64: ROT= 0: SCALE= 1
20 COL = 0:COL$ = "BLACK "
25 PIC$ = "PICTURE NOT NAMED "
30 KBD = -16384:SB = -16368:B1 = -16287:B2 = -16286:T = 3:K = 1.18
35 P2 = 6.28318531:S = .03498066585: DIM H(4),V(4):D$ = CHR$(4)
40 XO = 5:YO = 5:COL = 0:COL$ = "BLACK ":PIC$ = "PICTURE NOT NAMED "
45 HGR : GOTO 1000
47 XDRAW 1 AT X1,Y1
50 REM BASIC DRAW LOOP
55 IF PEEK(KBD) = 155 THEN POKE SB,0: GOTO 1000
65 X1 = INT( PDL(0) *277/255 +1):Y1 = INT( PDL(1) *189/255 +1)
70 IF SW THEN GOSUB 150: GOTO 50
75 IF PEEK(B1) < = 127 THEN 96
80 XO = X1 +1:YO = Y1 +1: HCOLOR= 3: HPLOT XO,YO: GOSUB 175
85 FOR D = 1 TO 500: NEXT
96 XDRAW 1 AT X1,Y1
100 IF PEEK(B2) >127 THEN GOSUB 150
105 GOTO 47
150 REM PLOT AND UPDATE
155 X3 = X1:Y3 = Y1
160 HCOLOR= COL
165 HPLOT XO,YO TO X3,Y3: HPLOT XO -1,YO TO X3 -1,Y3
170 XO = X3:YO = Y3
175 REM ENTER HERE TO UPDATE ONLY
180 H(0) = XO:V(0) = YO
185 FOR I = 4 TO 1 STEP -1:H(I) = H(I -1):V(I) = V(I -1): NEXT
190 RETURN
200 REM SELECT COLOR
205 HOME
210 PRINT "COLOR: B(LACK, L(IGHT BLUE, W(HITE,": PRINT " O(RANGE, P(URPLE, G(REEN"
215 GET CH$
220 IF CH$ = "B" THEN COL$ = "BLACK ":COL = 0: GOTO 1000
225 IF CH$ = "L" THEN COL$ = "LIGHT BLUE":COL = 6: GOTO 1000
230 IF CH$ = "W" THEN COL$ = "WHITE ":COL = 3: GOTO 1000
235 IF CH$ = "O" THEN COL$ = "ORANGE ":COL = 5: GOTO 1000
240 IF CH$ = "P" THEN COL$ = "PURPLE ":COL = 2: GOTO 1000
245 IF CH$ = "G" THEN COL$ = "GREEN ":COL = 1: GOTO 1000
250 GOTO 205
300 REM TURN PEN ON AND OFF
305 SW = NOT SW
310 IF NOT SW THEN SW$ = "OFF"
315 IF SW THEN SW$ = "ON"
320 GOTO 1000
400 REM CHANGE PICTURES
404 HOME
408 PRINT "PICTURES: N(AME, L(OAD, S(AVE,": PRINT " E(RASE, <ESC>"
412 ONERR GOTO 484
416 GET CH$
420 IF CH$ = CHR$(27) THEN POKE 216,0: GOTO 1000
424 IF CH$ = "E" THEN HOME : PRINT "ARE YOU SURE? ";: GET CH$: IF CH$ = "Y" THEN PIC$ = "PICTURE NOT NAMED ": HGR : POKE 216,0: GOTO 1000
428 IF CH$ = "N" THEN 460
432 IF CH$ = "S" THEN 476
436 IF CH$ < >"L" THEN POKE 216,0: GOTO 404
440 HOME : PRINT "NAME OF PICTURE TO LOAD:"
444 INPUT "",PIC$: IF LEN(PIC$) >25 THEN PIC$ = LEFT$(PIC$,25)
448 IF LEN(PIC$) <25 THEN PIC$ = PIC$ +" ": GOTO 448
452 PRINT D$;"BLOAD PBX.";PIC$;",A$2000"
456 POKE 216,0: GOTO 1000
460 HOME : PRINT "NAME THIS PICTURE:"
464 INPUT "";PIC$: IF LEN(PIC$) >25 THEN PIC$ = LEFT$(PIC$,25)
468 IF LEN(PIC$) <25 THEN PIC$ = PIC$ +" ": GOTO 468
472 POKE 216,0: GOTO 404
476 PRINT : PRINT D$;"BSAVE PBX.";PIC$;",A$2000,L$1FF8"
480 POKE 216,0: GOTO 1000
484 REM LOAD/SAVE ERRORS
488 EC = PEEK(222): IF EC = 6 THEN PRINT "NOT ON THIS DISK": FOR D = 1 TO 1500: NEXT : POKE 216,0: GOTO 404
492 IF EC = 9 THEN PRINT D$;"DELETE PBX.";PIC$: PRINT "THIS DISK IS FULL": FOR D = 1 TO 1500: NEXT : POKE 216,0: GOTO 404
496 PRINT "ERROR ENCOUNTERED. CHECK DISK, DRIVE, SYNTAX, AND TRY AGAIN.": FOR D = 1 TO 2500: NEXT : POKE 216,0: GOTO 404
500 REM SPECIAL EFFECTS
505 HOME
510 PRINT "SPECIAL EFFECTS: F(ILL, C(URVES, <ESC>"
515 GET CH$
520 IF CH$ = CHR$(27) THEN 1000
525 IF CH$ = "F" THEN 700
530 IF CH$ < >"C" THEN 505
535 Z = ABS(V(2) -V(1))
540 HOME : INPUT "ENTER NUMBER FOR 'A' AND <RETURN>: ";A
545 INPUT "ENTER NUMBER FOR 'B' AND <RETURN>: ";B
550 PRINT "MODULATE THIS CURVE? ";: GET CH$: PRINT : IF CH$ < >"Y" THEN M = 0:N = 0: GOTO 565
555 INPUT "ENTER % AMPLITUDE AND <RETURN>: ";M:M = M/100 *Z
560 INPUT "ENTER FREQUENCY AND <RETURN>: ";N
565 HCOLOR= COL
570 FOR TH = 0 TO P2 STEP S
575 R = Z * SIN(TH *T)
580 X2 = K *R * COS(A *TH) +H(2)
585 X2 = ABS(X2 +(K *M * COS(N *TH *T)))
590 Y2 = R * SIN(B *TH) +V(2)
595 Y2 = ABS(Y2 +(M * SIN(N *TH *T)))
600 IF TH = 0 THEN X1 = X2:Y1 = Y2
605 IF X1 >278 THEN X1 = 278 -(X1 -278)
610 IF Y1 >190 THEN Y1 = 190 -(Y1 -190)
615 IF X2 >278 THEN X2 = 278 -(X2 -278)
620 IF Y2 >190 THEN Y2 = 190 -(Y2 -190)
625 HPLOT X1,Y1 TO X2,Y2
630 HPLOT X1 +1,Y1 TO X2 +1,Y2
635 X1 = X2:Y1 = Y2
640 IF PEEK(B2) >127 THEN 1000
645 NEXT TH
650 GOTO 1000
700 REM FILL
705 A = V(2) -V(4): IF A = 0 THEN A = 1E -6
710 B = V(1) -V(3): IF B = 0 THEN B = 1E -6
715 C = H(2) -H(4): IF C = 0 THEN C = 1E -6
720 D = H(1) -H(3): IF D = 0 THEN D = 1E -6
725 HCOLOR= COL
730 FOR N = 0 TO A
735 X9 = H(4) +N *C/A
740 IF X9 <0 THEN X9 = 0
745 IF X9 >279 THEN X9 = 279
750 Y9 = V(4) +N
755 IF Y9 <0 THEN Y9 = 0
760 IF Y9 >191 THEN Y9 = 191
765 X8 = H(3) +N *D/B
770 IF X8 <0 THEN X8 = 0
775 IF X8 >279 THEN X8 = 279
780 Y8 = V(3) +N *B/A
785 IF Y8 <0 THEN Y8 = 0
790 IF Y8 >191 THEN Y8 = 191
795 HPLOT X9,Y9 TO X8,Y8
800 IF PEEK(B2) >127 THEN 1000
805 NEXT N
810 GOTO 1000
1000 REM NEW PAINTBOX MENU
1005 F = 1
1010 POKE -16304,0: POKE -16297,0: POKE -16301,0: POKE 34,20: HOME
1015 IF F = 1 THEN INVERSE
1020 HTAB 3: PRINT "COLOR: ";COL$;" ": NORMAL
1025 IF F = 2 THEN INVERSE
1030 HTAB 3: PRINT "PEN: ";SW$;" ": NORMAL
1035 IF F = 3 THEN INVERSE
1040 HTAB 3: PRINT "PICTURE: ";PIC$: NORMAL
1045 IF F = 4 THEN INVERSE
1050 HTAB 3: PRINT "SPECIAL EFFECTS (Q TO QUIT) ";: NORMAL
1055 GET CH$
1060 IF CH$ = CHR$(21) THEN F = F +1: IF F >4 THEN F = F -4
1065 IF CH$ = CHR$(8) THEN F = F -1: IF F <1 THEN F = F +4
1070 IF CH$ = CHR$(13) THEN ON F GOTO 200,300,400,500
1075 IF CH$ = CHR$(27) THEN POKE -16302,0: GOTO 50
1080 IF CH$ = "Q" THEN POKE 115,ML: POKE 116,MH: POKE 34,0: TEXT : POKE -16298,0: HOME : END
1085 GOTO 1010
2000 REM TITLE & INSTRUCTIONS
2005 HOME
2010 VTAB 11: HTAB 13: INVERSE : PRINT "---PAINTBOX---": NORMAL
2015 PRINT : HTAB 8: PRINT "COPYRIGHT 1980 BY AL EVANS"
2025 VTAB 24: HTAB 16: PRINT "INSTRUCTIONS?";: GET CH$: IF CH$ = "Y" THEN 2100
2030 CLEAR : GOTO 15
2100 REM GET INSTRUCTIONS FROM DISK
2105 LC = 0:I$ = "":D$ = CHR$(4): HOME
2110 ONERR GOTO 2200
2115 PRINT : PRINT D$;"OPEN PAINTBOX INSTRUCTIONS"
2120 PRINT : PRINT D$;"READ PAINTBOX INSTRUCTIONS"
2125 GET CH$: IF CH$ < > CHR$(13) THEN I$ = I$ +CH$: GOTO 2125
2130 PRINT : PRINT I$:I$ = "":LC = LC +1: IF LC <22 THEN 2125
2135 PRINT : PRINT D$: HTAB 11: INVERSE : PRINT "<RETURN> FOR MORE";: NORMAL
2140 GET CH$: IF CH$ < > CHR$(13) THEN 2140
2145 LC = 0: GOTO 2120
2200 PRINT : VTAB 24: HTAB 15: PRINT "**THE END**"
2205 PRINT "PRESS 'A' TO SEE INSTRUCTIONS AGAIN"
2210 PRINT "PRESS <RETURN> TO START PAINTING "
2215 PRINT D$;"CLOSE PAINTBOX INSTRUCTIONS"
2220 GET CH$: IF CH$ = "A" THEN 2100
2225 POKE 216,0: CLEAR : GOTO 15